home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
tpdb13.arc
/
DEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-02-13
|
5KB
|
187 lines
{$A+,B+,D-,E+,F-,I-,L-,N-,O-,R-,S-,V-}
{$M 16384,0,655360}
Program Demo;
Uses Crt,Dos,TPDB;
{Demonstrates the use of TPDB to append, search, and edit a dBASE
file from a Turbo Pascal program.}
Var
SPos : Byte;
Procedure SetUp;
begin
DBOpenFile('demo.dbf');
Normal := White+BlueBG;
Reverse := Black+LightGrayBG;
SetColor(White,Blue);
ClrScr;
SetColor(Black,LightGray);
end;
Procedure GetInput;
Var
Continue : String[1];
begin
Block;
Repeat
Continue := #0;
NewDBRec;
Prompt(2,5,'Enter Last Name: ');
Say(1,2,22);
Prompt(4,5,'Enter Address: ');
Say(2,4,22);
Prompt(6,5,'Enter City: ');
Say(3,6,17);
Prompt(8,5,'Enter State: ');
Say(4,8,19);
Prompt(10,5,'Enter ZIP: ');
Say(5,10,16);
Prompt(12,5,'Enter an Integer: ');
Say(6,12,24);
Prompt(14,5,'Enter a Real number: ');
Say(7,14,27);
Prompt(16,5,'Enter a Date: ');
Say(8,16,20);
Prompt(18,5,'Enter Y or N: ');
Say(9,18,20);
GotoXY(5,20);
Write('Press the Escape key when finished.');
SPos := 1;
Repeat
Case SPos of
1 : Get(1,2,22);
2 : Get(2,4,22);
3 : Get(3,6,17);
4 : Get(4,8,19);
5 : Get(5,10,16);
6 : Get(6,12,24);
7 : Get(7,14,27);
8 : Get(8,16,20);
9 : Get(9,18,20);
end;
CheckScreen(SPos,BC,Up,Down,1,9);
Until BC in Next;
AddDBRec;
Prompt(22,5,'Add another record ? (Y or N)');
BC := GetString(Continue,1,36,22);
SetColor(Blue,Blue);
GotoXY(5,22);
ClrEol;
SetColor(Black,LightGray);
Continue := Upper(Continue);
Until Continue = 'N';
end;
Procedure Index;
begin
SetColor(White,Blue);
ClrScr;
Writeln('Building an index on the NAME field: ');
UCKey := True; {Convert each key string to upper case}
BuildIndex('demo.ndx',1,30,Duplicates);
end;
Procedure SeekRecord;
Var
LastName : String[30];
begin
OpenDBIndex('demo.ndx',30,Duplicates);
Repeat
LastName := '';
ClrScr;
Prompt(5,5,'Enter Last Name to Find: ');
Prompt(7,5,'Press Escape to Quit.');
BC := GetString(LastName,30,30,5);
If BC = #27 then Exit;
Find(LastName);
If not Found then Find(Upper(LastName));
If Found then
begin
ClrScr;
FlashFill(1,1,25,80,Blue+BlackBG,#176);
Prompt(2,5,'Enter Last Name: ');
Say(1,2,22);
Prompt(4,5,'Enter Address: ');
Say(2,4,22);
Prompt(6,5,'Enter City: ');
Say(3,6,16);
Prompt(8,5,'Enter State: ');
Say(4,8,19);
Prompt(10,5,'Enter ZIP: ');
Say(5,10,16);
Prompt(12,5,'Enter an Integer: ');
Say(6,12,24);
Prompt(14,5,'Enter a Real number: ');
Say(7,14,27);
Prompt(16,5,'Enter a Date: ');
Say(8,16,20);
Prompt(18,5,'Enter Y or N: ');
Say(9,18,20);
GotoXY(5,20);
Write('Press the Escape key when finished.');
SPos := 1;
Repeat
Case SPos of
1 : Get(1,2,22);
2 : Get(2,4,22);
3 : Get(3,6,16);
4 : Get(4,8,19);
5 : Get(5,10,16);
6 : Get(6,12,24);
7 : Get(7,14,27);
8 : Get(8,16,20);
9 : Get(9,18,20);
end;
CheckScreen(SPos,BC,Up,Down,1,9);
Until BC in Next;
end
else
begin
Writeln;
Writeln(#7);
Prompt(6,15,'NAME NOT FOUND !');
Wait;
end;
Until BC = #27;
end;
Procedure CloseOut;
begin
CloseDBFile;
CloseDBIndex;
ClrScr;
FlashFill(1,1,25,80,Blue+BlackBG,#177);
FlashC(10,White+RedBG,'TPDB Version 1.3');
FlashC(12,White+RedBG,'By Brian Corll');
FlashC(14,White+RedBG,'Copyright 1989');
Repeat Until KeyPressed;
ClrScr;
end;
Procedure ErrorDemo;
begin
OpenDBIndex('demo.ndx',50,Duplicates);
end;
begin
{Bracket out these routines and substitute ErrorDemo for
a demonstration of the TPDB error handler. In this case,
the wrong field length is specified as the KeyLen in the
call to ErrorDemo.}
SetUp;
GetInput;
Index;
SeekRecord;
CloseOut;
{ErrorDemo;}
end.